Celem projektu jest określenie przyczyn stopniowego zmniejszania się długości śledzi oceanicznych wyławianych w Europie. Do analizy wykorzystano dane o pomiarze oraz warunkach życia śledzia oceanicznego w Europie z okresu ponad pięćdziesięciu lat. Analizowane dane obejmowały ponad 50 tysięcy rekordów. W celu rozpoznania przyczyn malejącego rozmiaru śledzia dokonano predykcji jego rozmiaru oraz przeprowadzono analizę ważności atrybutów najlepszego znalezionego modelu regresji. Analizując rozkład wartości danych oraz współczynnik korelacji atrybutów stwierdzono, iż dla zmiennych lcop1, lcop2, cumf oraz totaln istnieje silna współliniowość i atrybuty te powinny zostać usunięte, ponieważ mogą wpływać negatywnie na wyniki predykcji.Na podstawie uzyskanych wyników wnioskować można, że na zmniejszanie rozmiaru śledzi największy wpływ ma temperatura przy powierzchni wody, jednak bardzo istotny jest także miesiąc połowu. Można więc przypuszczać, że przyczyną zmniejszania się śledzi jest zjawisko globalnego ocieplenia.
library('knitr')
library('dplyr')
library('ggplot2')
library('plotly')
library('reshape2')
library('corrplot')
library('caret')
Aby wyniki raportu były powtarzalne ustawione zostało ziarno.
set.seed(22)
Dane zostały wczytane z pliku CSV znajdującego się pod adresem http://www.cs.put.poznan.pl/dbrzezinski/teaching/zed/sledzie.csv. Zaznaczono również, że brakujące wartości zostały oznaczone w zbiorze danych znakiem ?. Przedstawiono również 10 pierwszych wierszy zbioru danych w celu zapoznania się z ich strukturą.
df <- read.csv(url("http://www.cs.put.poznan.pl/dbrzezinski/teaching/zed/sledzie.csv"), na.strings ="?")
df <- tbl_df(df)
head(df,10)
## # A tibble: 10 × 16
## X length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 23.0 0.02778 0.27785 2.46875 NA 2.54787 26.35881 0.356
## 2 1 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 3 2 25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 4 3 25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 5 4 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 6 5 22.0 0.02778 0.27785 2.46875 21.43548 2.54787 NA 0.356
## 7 6 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 8 7 23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 9 8 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## 10 9 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356
## # ... with 7 more variables: recr <int>, cumf <dbl>, totaln <dbl>,
## # sst <dbl>, sal <dbl>, xmonth <int>, nao <dbl>
Zbiór danych posiada następujące rozmiary
dim(df)
## [1] 52582 16
Poniżej przedstawiono podstawowe statystyki dla badanego zbioru danych.
kable(summary(df))
| length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 | |
|---|---|---|---|---|---|---|---|
| Min. :19.0 | Min. : 0.0000 | Min. : 0.0000 | Min. : 0.000 | Min. : 5.238 | Min. : 0.3074 | Min. : 7.849 | |
| 1st Qu.:24.0 | 1st Qu.: 0.0000 | 1st Qu.: 0.2778 | 1st Qu.: 2.469 | 1st Qu.:13.427 | 1st Qu.: 2.5479 | 1st Qu.:17.808 | |
| Median :25.5 | Median : 0.1111 | Median : 0.7012 | Median : 5.750 | Median :21.673 | Median : 7.0000 | Median :24.859 | |
| Mean :25.3 | Mean : 0.4458 | Mean : 2.0248 | Mean :10.006 | Mean :21.221 | Mean : 12.8108 | Mean :28.419 | |
| 3rd Qu.:26.5 | 3rd Qu.: 0.3333 | 3rd Qu.: 1.7936 | 3rd Qu.:11.500 | 3rd Qu.:27.193 | 3rd Qu.: 21.2315 | 3rd Qu.:37.232 | |
| Max. :32.5 | Max. :37.6667 | Max. :19.3958 | Max. :75.000 | Max. :57.706 | Max. :115.5833 | Max. :68.736 | |
| NA | NA’s :1581 | NA’s :1536 | NA’s :1555 | NA’s :1556 | NA’s :1653 | NA’s :1591 |
| fbar | recr | cumf | totaln | sst | sal | xmonth | |
|---|---|---|---|---|---|---|---|
| Min. :0.0680 | Min. : 140515 | Min. :0.06833 | Min. : 144137 | Min. :12.77 | Min. :35.40 | Min. : 1.000 | |
| 1st Qu.:0.2270 | 1st Qu.: 360061 | 1st Qu.:0.14809 | 1st Qu.: 306068 | 1st Qu.:13.60 | 1st Qu.:35.51 | 1st Qu.: 5.000 | |
| Median :0.3320 | Median : 421391 | Median :0.23191 | Median : 539558 | Median :13.86 | Median :35.51 | Median : 8.000 | |
| Mean :0.3304 | Mean : 520367 | Mean :0.22981 | Mean : 514973 | Mean :13.87 | Mean :35.51 | Mean : 7.258 | |
| 3rd Qu.:0.4560 | 3rd Qu.: 724151 | 3rd Qu.:0.29803 | 3rd Qu.: 730351 | 3rd Qu.:14.16 | 3rd Qu.:35.52 | 3rd Qu.: 9.000 | |
| Max. :0.8490 | Max. :1565890 | Max. :0.39801 | Max. :1015595 | Max. :14.73 | Max. :35.61 | Max. :12.000 | |
| NA | NA | NA | NA | NA’s :1584 | NA | NA |
Ilość brakujących wartości dla poszczególnych zmiennych wygląda następująco:
na_count <-sapply(df, function(y) sum(length(which(is.na(y)))))
na_count <- data.frame(na_count)
na_count
## na_count
## X 0
## length 0
## cfin1 1581
## cfin2 1536
## chel1 1555
## chel2 1556
## lcop1 1653
## lcop2 1591
## fbar 0
## recr 0
## cumf 0
## totaln 0
## sst 1584
## sal 0
## xmonth 0
## nao 0
Usunięto brakujące wartości ze zbioru danych poprzez podstawienie do zmiennych średniej arytmetycznej z danego połowu. Dane zostały pogrupowane wzlędem atrybutu nao.
df2 <- df %>%
group_by(nao) %>%
mutate(
cfin1 = mean(cfin1, na.rm = TRUE),
cfin2 = mean(cfin2, na.rm = TRUE),
chel1 = mean(chel1, na.rm = TRUE),
chel2 = mean(chel2, na.rm = TRUE),
lcop1 = mean(lcop1, na.rm = TRUE),
lcop2 = mean(lcop2, na.rm = TRUE),
sst = mean(sst, na.rm = TRUE)
) %>%
select(-X)
Poniżej zostały przedstawione histogramy dla atrybutów w zbiorze danych. Można zauważyć, że poza atrybutem length, który ma rozkład zbliżony do normalnego, reszta atrybutów ma bardzo nieregularne rozkłady wartości ze względu na wysoką powtarzalność danych.
headers <- c(names(df2))
for (i in headers){
xcol <- df2[i]
a <- ggplot(df2,aes(xcol)) + geom_histogram(col="black", fill="#3366FF",
alpha = .75 , bins = 30) + xlab(i) + ggtitle(paste("Histogram zmiennej " ,i)) + xlim(min(xcol),max(xcol)) + theme_minimal() + theme(plot.title = element_text(hjust = 0.5))
print(a)
}
Na interaktywnym wykresie zobrazowano jak zmieniał się rozmiar śledzia odkąd rozpoczęto obserwację.
lengthInTime <- ggplot(df,aes(X,length)) + geom_smooth(method="auto", se=FALSE) + xlab("observation") + geom_hline(aes(yintercept=mean(length)),linetype="dashed",colour="red")
ggplotly(lengthInTime)
Zauważono wyraźny spadek rozmiaru śledzia w badanym okresie.
W celu zbadania występowania korelacji między zmiennymi utworzono macierz korelacji.
Matrix <- cor(df2)
Matrix <- round(Matrix,2)
corrplot(Matrix, method="color",type = "upper", addCoef.col = "black", tl.col="black")
Zmienne między którymi występuje silna współliniowość (tj. takie, dla których współczynnik korelacji przyjmuje wartości wyższe od 0,7) powinny zostać wyeliminowane. W badanym przypadku współczynnik korelacji przekroczył wartość 0,7 dla czterech zmiennych: lcop1, lcop2, cumf oraz totaln, co stanowi podstawę do ich eliminacji.
Zgodnie z poprzednim punktem dokonano wyboru atrybutów, które pomogą poprawnie przewidzieć wielkość śledzia i nie będą negatywnie wpływać na wyniki. Podzielono dane na zbiory treningowy (70%) i testowy (30%). Metodą oceny regresora będzie 10- krotna walidacja krzyżowa. Do budowy modelu regresora wybrano algorytm Random Forest ze względu na większą dokładność predykcji oraz skuteczność przy większej ilości danych.
fit <- train(length~.,
data = herringTrain,
method = "rf",
trControl = ctrl,
importance =TRUE,
ntree = 10)
Dla uzyskanego modelu obliczono wartość RMSE, czyli średniej kwadratowej błędów oraz współczynik determinacji R^2, na podstawie których szacuje się, że zbudowany model jest wzglednie zadowalający.
fit
## Random Forest
##
## 36810 samples
## 10 predictor
##
## No pre-processing
## Resampling: Cross-Validated (6 fold, repeated 10 times)
## Summary of sample sizes: 30675, 30675, 30675, 30675, 30675, 30675, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared
## 2 1.167209 0.5008894
## 6 1.142865 0.5214394
## 10 1.138733 0.5249882
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 10.
Poniższy wykres prezentuje przewidywany oraz rzeczywisty zakres długości śledzia.
p <- ggplot(predictionPlot,aes(x=length, y=prediction, color=length)) + geom_point() + geom_abline(color="red") + xlim(min(actual),max(actual)) + ylim(min(actual),max(actual)) + xlab("actual length") + ylab("predicted length")
ggplotly(p)
W celu rozpoznania przyczyn malejącego rozmiaru śledzia przeprowadzono analizę ważności atrybutów najlepszego znalezionego modelu regresji.
atrrImp <- varImp(fit)
plot(atrrImp)
Na powyższym wykresie atrybuty zostały uporządkowane malejąco według stopnia istotności. Na jego podstawie stwierdzić można, że dwoma najważniejszymi atrybutami są temperatura przy powierzchni wody oraz miesiąc połowu. Oznacza to, że wymienione dwa czynniki w głównej mierze mają wpływ na zmniejszanie się rozmiaru śledzi.